;;;; 2008-05-27 12:12:44
;;;; This is your lisp file. There are many like it but this one is yours.

(in-package :learning-lisp)

(defstruct participant
  data-1
  data-2
  gender
  age-group
  )

(defun sum (lst &optional (i 1) n) 
  (reduce #'+ lst :start (- i 1) :end n)
  )

(defun mean (lst) 
  (/ (sum lst) (length lst))
  )

(defun square (x)
  (* x x)
  )

(defun variance (lst)
  (let ((y (mean lst))) 
    (/ (reduce 
        (lambda (a b) 
          (+ (square (- y b)) a))
        lst)
       (- (length lst) 1)) 
    )
  )

(defun occurs (e lst)
  (if (car lst)
  (if (eql e (car lst)) 
      (+ 1 (occurs e (cdr lst)))
      (occurs e (cdr lst))
      )
      0)
  )

(defun frequency (e lst)
  (/ (occurs e lst) (length lst))
  )

(defun freq-dist (pick in-set)
  (if (car pick)
      (cons (list (car pick) (occurs (car pick) in-set)) (freq-dist (cdr pick) in-set))
      '())
  )

(defun freq-dist-all (in-set)
  (freq-dist (remove-duplicates in-set) in-set)
  )

(defun build-participant-list (lst-of-lst)
  (mapcar 
   (lambda (item)
     (make-participant 
      :data-1 (subseq item 0 10)
      :data-2 (subseq item 10 27)
      :gender (car (subseq item 27 28))
      :age-group (car (subseq item 28 29))
      )
     )
   lst-of-lst 
   )
  )

(defun filter-participants (structs &optional exclude-age-groups exclude-gender)
  (remove nil (mapcar 
   (lambda (item)
     (if (or 
          (find (participant-age-group item) exclude-age-groups) 
          (find (participant-gender item) exclude-gender) ) 
         nil
         item
         )
     )
   structs
   ))
  )

(defun flip (m n)
  (let ( (mid (/ (+ n 1) 2)) ) 
    (+ (- mid m) mid)
    )
  )

(defun interleave (lst1 lst2)
  (if (and (car lst1) (car lst2))
      (cons (list (car lst1) (car lst2)) (interleave (cdr lst1) (cdr lst2))) 
      '()
      )
  )

(defun replace-item (lst indx item) 
  (if (> indx 0)
     (cons (car lst) (replace-item (cdr lst) (- indx 1) item) )
     (cons item (cdr lst)))
  )

(defun sum-participant-data-1 (participants)
  (mapcar 
   (lambda (item) 
     (let ( (lst (participant-data-1 item)) )
       (setf lst (replace-item lst 2 (flip (nth 2 lst) 5)) )
       (setf lst (replace-item lst 7 (flip (nth 7 lst) 5)) )
       (setf lst (replace-item lst 8 (flip (nth 8 lst) 5)) )
       (sum lst) 
       )
     )
   participants
   )
  )

(defun sum-participant-data-2 (participants)
  (mapcar
   (lambda (item)
     (let ( (lst (participant-data-2 item)) )
       (setf lst (replace-item lst 1 (flip (nth 1 lst) 6)) )
       (setf lst (replace-item lst 2 (flip (nth 2 lst) 6)) )
       (setf lst (replace-item lst 3 (flip (nth 3 lst) 6)) )
       (setf lst (replace-item lst 6 (flip (nth 6 lst) 6)) )
       (setf lst (replace-item lst 8 (flip (nth 8 lst) 6)) )
       (setf lst (replace-item lst 9 (flip (nth 9 lst) 6)) )
       (setf lst (replace-item lst 10 (flip (nth 10 lst) 6)) )
       (setf lst (replace-item lst 11 (flip (nth 11 lst) 6)) )
       (setf lst (replace-item lst 14 (flip (nth 14 lst) 6)) )
       (setf lst (replace-item lst 15 (flip (nth 15 lst) 6)) )
       (setf lst (replace-item lst 16 (flip (nth 16 lst) 6)) )
       (sum lst) 
       )
     )
   participants
   )
  )

(defun read-data-file (fname)
  (let ( (fh (open fname :direction :input)) (data-set '()) )
    (when fh
      (loop for lst = (read-line fh nil)
            while lst do (setf data-set (cons (read-from-string lst) data-set))
            )
      (close fh)
      data-set
      )
    )
  )

(defun out-to-plot (pts fname &optional xrange yrange xlabel ylabel type)
  (let ((dat (open (concatenate 'string fname ".data") :direction :output :if-exists :supersede))
        (plt (open (concatenate 'string fname ".plt") :direction :output :if-exists :supersede)))
    (when dat
      (dolist (coord pts)
        (dolist (e coord)
          (format dat " ~A" e)
        )
        (format dat "~%")
        )
      (close dat)
      )
    (when (and plt xrange yrange xlabel ylabel type)
      (format plt "set xrange [~A : ~A]~%" (car xrange) (car (cdr xrange)))
      (format plt "set yrange [~A : ~A]~%" (car yrange) (car (cdr yrange)))
      (format plt "set xlabel \"~A\"~%" xlabel)
      (format plt "set ylabel \"~A\"~%" ylabel)
      (format plt "plot \"~A.data\" with ~A title \"~A\"~%" fname type fname)
      (close plt)
      )
    )
  )

; frequency dist for group survey
;(setf raw (read-data-file "raw-survey.dat"))
;(setf p-list (build-participant-list raw))
;(setf tot-1 (sum-participant-data-1 p-list))
;(setf distro-1 (freq-dist-all tot-1))
;(out-to-plot distro-1 "Fig-1" '(22 46) '(0 7) "Score" "Num-Participants" "impulses")

; frequency dist for existing survey
;(setf tot-2 (sum-participant-data-2 p-list))
;(setf distro-2 (freq-dist-all tot-2))
;(out-to-plot distro-2 "Fig-2" '(34 95) '(0 4) "Score" "Num-Participants" "impulses")

; correlational graph of two surveys
;(setf cor-data (interleave tot-1 tot-2))
;(out-to-plot cor-data "Fig-3" '(20 50) '(20 100) "Group-Survey" "Official-Survey" "points")

; male dist for group survey
;(setf only-males (filter-participants p-list '() '(F)))
;(setf male-tot (sum-participant-data-1 only-males))
;(setf distro-3 (freq-dist-all male-tot))
;(out-to-plot distro-3 "Fig-4" '(22 46) '(0 7) "Score" "Male-Participants" "impulses")

; female dist for group survey
;(setf only-females (filter-participants p-list '() '(M)))
;(setf female-tot (sum-participant-data-1 only-females))
;(setf distro-4 (freq-dist-all female-tot))
;(out-to-plot distro-4 "Fig-5" '(22 46) '(0 7) "Score" "Female-Participants" "impulses")

; under 40 dist for group survey
;(setf under-40 (filter-participants p-list '(4 5 6) '()))
;(setf under-40-tot (sum-participant-data-1 under-40))
;(setf distro-5 (freq-dist-all under-40-tot))
;(out-to-plot distro-5 "Fig-6" '(22 46) '(0 7) "Score" "Participants Under 40" "impulses")

; over 40 dist for group survey
;(setf over-40 (filter-participants p-list '(1 2 3) '()))
;(setf over-40-tot (sum-participant-data-1 over-40))
;(setf distro-6 (freq-dist-all over-40-tot))
;(out-to-plot distro-6 "Fig-7" '(22 46) '(0 7) "Score" "Participants 40+" "impulses")
